home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tix8.1 / LabWidg.tcl < prev    next >
Text File  |  2001-11-03  |  4KB  |  158 lines
  1. # -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
  2. #
  3. #    $Id: LabWidg.tcl,v 1.2.2.1 2001/11/03 07:48:00 idiscovery Exp $
  4. #
  5. # LabWidg.tcl --
  6. #
  7. #    TixLabelWidget: Virtual base class. Do not instantiate
  8. #
  9. #     This widget class is the base class for all widgets that has a
  10. #     label. Most Tix compound widgets will have a label so that
  11. #     the app programmer doesn't need to add labels themselvel.
  12. #
  13. #
  14. # Copyright (c) 1993-1999 Ioi Kim Lam.
  15. # Copyright (c) 2000-2001 Tix Project Group.
  16. #
  17. # See the file "license.terms" for information on usage and redistribution
  18. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  19. #
  20.  
  21. # LabelSide : top, left, right, bottom, none, acrosstop
  22. #
  23. # public widgets:
  24. #    frame, label
  25. #
  26.  
  27. tixWidgetClass tixLabelWidget {
  28.     -superclass tixPrimitive
  29.     -classname  TixLabelWidget
  30.     -flag {
  31.     -label -labelside -padx -pady
  32.     }
  33.     -static {-labelside}
  34.     -configspec {
  35.     {-label label Label ""}
  36.     {-labelside labelSide LabelSide left}
  37.     {-padx padX Pad 0}
  38.     {-pady padY Pad 0}
  39.     }
  40. }
  41.  
  42. proc tixLabelWidget:ConstructWidget {w} {
  43.     upvar #0 $w data
  44.  
  45.     tixChainMethod $w ConstructWidget
  46.  
  47.     if {$data(-labelside) != "acrosstop"} {
  48.     set data(w:frame) [frame $w.frame]
  49.     } else {
  50.     set data(pw:border) [frame $w.border]
  51.     set data(pw:pad)    [frame $w.border.pad]
  52.     set data(w:frame)   [frame $w.border.frame]
  53.     }
  54.  
  55.     if {$data(-labelside) != "none"} {
  56.     set data(w:label) [label $w.label -text $data(-label)]
  57.     }
  58.     tixLabelWidget:Pack $w
  59.  
  60.     tixCallMethod $w ConstructFramedWidget $data(w:frame)
  61. }
  62.  
  63. proc tixLabelWidget:ConstructFramedWidget {w frame} {
  64.     # Do nothing
  65. }
  66.  
  67. proc tixLabelWidget:Pack {w} {
  68.     upvar #0 $w data
  69.  
  70.     if {[catch {tixLabelWidget:Pack-$data(-labelside) $w}]} {
  71.     error "unknown -labelside option \"$data(-labelside)\""
  72.     }
  73. }
  74.  
  75. proc tixLabelWidget:Pack-acrosstop {w} {
  76.     upvar #0 $w data
  77.  
  78.     set labHalfHeight [expr [winfo reqheight $data(w:label)] / 2]
  79.     set padHeight [expr $labHalfHeight - [$data(pw:border) cget -bd]]
  80.     if {$padHeight < 0} {
  81.     set padHeight 0
  82.     }
  83.  
  84.     tixForm $data(w:label) -top 0 -left 4\
  85.     -padx [expr $data(-padx) +4] -pady $data(-pady)
  86.     tixForm $data(pw:border) -top $labHalfHeight -bottom -1 \
  87.     -left 0 -right -1 -padx $data(-padx) -pady $data(-pady)
  88.     tixForm $data(pw:pad) -left 0 -right -1 \
  89.     -top 0 -bottom $padHeight
  90.     tixForm $data(w:frame) -top $data(pw:pad) -bottom -1 \
  91.     -left 0 -right -1
  92. }
  93.  
  94. proc tixLabelWidget:Pack-top {w} {
  95.     upvar #0 $w data
  96.  
  97.     pack $data(w:label) -side top \
  98.     -padx $data(-padx) -pady $data(-pady) \
  99.     -fill x
  100.     pack $data(w:frame) -side top \
  101.     -padx $data(-padx) -pady $data(-pady) \
  102.     -expand yes -fill both
  103. }
  104.  
  105. proc tixLabelWidget:Pack-bottom {w} {
  106.     upvar #0 $w data
  107.  
  108.     pack $data(w:label) -side bottom \
  109.     -padx $data(-padx) -pady $data(-pady) \
  110.     -fill x
  111.     pack $data(w:frame) -side bottom \
  112.     -padx $data(-padx) -pady $data(-pady) \
  113.     -expand yes -fill both
  114. }
  115.  
  116. proc tixLabelWidget:Pack-left {w} {
  117.     upvar #0 $w data
  118.  
  119.     pack $data(w:label) -side left \
  120.     -padx $data(-padx) -pady $data(-pady) \
  121.     -fill y
  122.     pack $data(w:frame) -side left \
  123.     -padx $data(-padx) -pady $data(-pady) \
  124.     -expand yes -fill both
  125. }
  126.  
  127. proc tixLabelWidget:Pack-right {w} {
  128.     upvar #0 $w data
  129.  
  130.     pack $data(w:label) -side right \
  131.     -padx $data(-padx) -pady $data(-pady) \
  132.     -fill x
  133.     pack $data(w:frame) -side right \
  134.     -padx $data(-padx) -pady $data(-pady) \
  135.     -expand yes -fill both
  136. }
  137.  
  138. proc tixLabelWidget:Pack-none {w} {
  139.     upvar #0 $w data
  140.  
  141.     pack $data(w:frame)\
  142.     -padx $data(-padx) -pady $data(-pady) \
  143.     -expand yes -fill both
  144. }
  145.  
  146. #----------------------------------------------------------------------
  147. #                           CONFIG OPTIONS
  148. #----------------------------------------------------------------------
  149. proc tixLabelWidget:config-label {w value} {
  150.     upvar #0 $w data
  151.  
  152.     $data(w:label) config -text $value
  153.  
  154.     if {$data(-labelside) == "acrosstop"} {
  155.     tixLabelWidget:Pack-acrosstop $w
  156.     }
  157. }
  158.